home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / SPREOTUS / 123TECH.LZH / 123DOC.BAS next >
BASIC Source File  |  1984-12-07  |  8KB  |  241 lines
  1.  105    ' ********* BASIC version of RatBas program ********** 
  2.  110     DefInt i-n 
  3.  115   'basica defs
  4.  120   defint a-z
  5.  125   dim cols$(110),rows$(60),table(60,100),cells$(1010)
  6.  130   dim cols.w(110)
  7.  135   '
  8.  140   '
  9.  145    GO TO 25000 ' jump to program 
  10.  200    '----------------------- PROCEDURE SET.SCREEN
  11.  205   cls
  12.  210   locate 25,5:print "Press [esc] to terminate run"
  13.  215   locate 1,1: print "Documentation of ";infile$
  14.  220   locate 05,5:print "cells present for rows";rp*ipc+1;" to";rp*ipc+rp
  15.  225   pset (33,49): draw "r530d110l530u110"
  16.  230    RETURN ' ------------------------------------------
  17.  235   '
  18.  240   '
  19.  300    '----------------------- PROCEDURE FILLER
  20.  305   '
  21.  310   'fills in the column letters A thru CZ
  22.  315   for i=1 to 26: cols$(i     )=  chr$(64+i): next i
  23.  320   for i=1 to 26: cols$(i+26)="A"+cols$(i): next i
  24.  325   for i=1 to 26: cols$(i+52)="B"+cols$(i): next i
  25.  330   for i=1 to 26: cols$(i+78)="C"+cols$(i): next i
  26.  335   nc=4*26
  27.  340    RETURN ' ------------------------------------------
  28.  345   '
  29.  350   '
  30.  355   '
  31.  360   '
  32.  400    '----------------------- PROCEDURE READ.LINE
  33.  405   '
  34.  410   'this procedure reads one lin from the lotus doc file and decodes
  35.  415   'it to address and contents
  36.  420   '
  37.  425   IF NR=0 AND LIN<>0  THEN ELSE GO TO  445
  38.  430       lin$=old.lin$                'restore last line from old page
  39.  435       lin=lin-1
  40.  440    GO TO   465
  41.  445    ' ELSE] 
  42.  450       input #1, lin$                'get new line
  43.  455       old.lin$=lin$                'save last line for next page
  44.  460       lin=lin+1
  45.  465    ' IFEnd] 
  46.  470   '
  47.  475   ic=instr(lin$,":")
  48.  480   IF IC<>0  THEN ELSE GO TO  550
  49.  485                          'remove row/col chars and store
  50.  490       row$="": col$=""
  51.  495       for i=1 to ic-1
  52.  500       c$=mid$(lin$,i,1): ichar=asc(c$)
  53.  505       IF ICHAR>64 AND ICHAR<91  THEN ELSE GO TO  520
  54.  510           col$=col$+c$        'alphabetic
  55.  515    GO TO   530
  56.  520    ' ELSE] 
  57.  525           row$=row$+c$        'numeric
  58.  530        ' IFEnd] 
  59.  535       next i
  60.  540                          'remove cell contents always getting at least a :
  61.  545       cell$=mid$(lin$,ic)
  62.  550    ' IFEnd] 
  63.  555    RETURN ' ------------------------------------------
  64.  560   '
  65.  565   '
  66.  570   '
  67.  575   '
  68.  600    '----------------------- PROCEDURE STORE.CELL
  69.  605   '
  70.  610   'this procedure stores the row/col/cell info in table/list
  71.  615   'constructing a row/col index as it goes to fill a 55 by 100 matrix
  72.  620   '
  73.  625   'find the row and col
  74.  630   '
  75.  635   ir=0
  76.  640   for i=1 to nr
  77.  645       if row$=rows$(i) then ir=i
  78.  650   next i
  79.  655   if ir=0 then nr=nr+1:rows$(nr)=row$:ir=nr
  80.  660   jc=0
  81.  665   for j=1 to nc                'fixed column letters
  82.  670       if col$=cols$(j) then jc=j
  83.  675   next j
  84.  680   '
  85.  685   'store the cell
  86.  690   if max.cols<jc then max.cols=jc
  87.  695   ncell=ncell+1
  88.  700   table(ir,jc)=ncell
  89.  705   cells$(ncell)=cell$
  90.  710   colw=len(cell$): if colw>cols.w(jc) then cols.w(jc)=colw
  91.  715   '
  92.  720   pset(33+5*jc,49+2*ir)
  93.  725   locate 1,35: print "Page..";ipc+1;" Rows..";ir;" Cols..";Max.cols;" cells..";ncell
  94.  730   '
  95.  735    RETURN ' ------------------------------------------
  96.  740   '
  97.  745   '
  98.  750   '
  99.  755   '
  100.  760   '
  101.  800    '----------------------- PROCEDURE PRINT.TABLE
  102.  805   '
  103.  810   '
  104.  815   'this procedure prints the table in pages accross the table 100 cols/page
  105.  820   ' with ncell.colw cols/cell, overlapping
  106.  825   '
  107.  830   'compute np the # of pages accross the table, and ncols/page
  108.  835   ncols=int(max.chars/ncell.colw)-1      '# of columns this page
  109.  840   if ncols=0 then ncols=1
  110.  845   np=int(max.cols/ncols+1)
  111.  850   '
  112.  855   nr=nr-1                    'drop last line for next page
  113.  860                          'page loop
  114.  865   ipc=ipc+1                   'overall page count
  115.  870   for ip=1 to np                   'slice count
  116.  875   '
  117.  880       lprint chr$(12),chr$(15)           'compressed characters
  118.  885   '
  119.  890       lprint tab(15);"Date: ";date$;tab(max.chars-15);"Page:";ipc;"/";ip
  120.  895       lprint chr$(14),tab(5+max.chars/8);"Documentation for ";infile$
  121.  900       lprint tab(15);string$(max.chars,"-")
  122.  905                           'col headers
  123.  910       lin$=string$(max.chars," ")
  124.  915       for jj=1 to ncols
  125.  920       j=(ip-1)*ncols+jj
  126.  925       mid$(lin$,jj*ncell.colw)=cols$(j)+"["+str$(cols.w(j))+"]"
  127.  930       cols.w(j)=0
  128.  935       next jj
  129.  940       mid$(lin$,1)="Col[width]"
  130.  945       lprint tab(15);lin$
  131.  950       lprint tab(15);string$(max.chars,"-")
  132.  955                          'row loop
  133.  960       for i=1 to nr
  134.  965       multiple.row=true
  135.  970       while multiple.row
  136.  975           multiple.row=false
  137.  980           lin$=string$(max.chars," ")
  138.  985           mid$(lin$,4)="&"+rows$(i)
  139.  990           ib=1               'normal no. of blank cells
  140.  995           for jj=ncols to 1 step -1
  141.  1000           j=(ip-1)*ncols+jj
  142.  1005           k=table(i,j)
  143.  1010           IF K<>0  THEN ELSE GO TO  1035
  144.  1015               mid$(lin$,jj*ncell.colw,ib*ncell.colw)=cells$(k)
  145.  1020               cells$(k)="&  "+mid$(cells$(k),ib*ncell.colw+1)
  146.  1025               ib=1
  147.  1030    GO TO   1045
  148.  1035    ' ELSE] 
  149.  1040               ib=ib+1           'multiple cell possible
  150.  1045            ' IFEnd] 
  151.  1050           if len(cells$(k))<4 then table(i,j)=0 else multiple.row=true
  152.  1055           next jj
  153.  1060           if not multiple.row then mid$(lin$,4)=" "
  154.  1065           lprint tab(15);lin$
  155.  1070       wend
  156.  1075       next i
  157.  1080       lprint
  158.  1085       status$=inkey$
  159.  1090       IF STATUS$=CHR$(27)  THEN ELSE GO TO  1100
  160.  1095       end
  161.  1100        ' IFEnd] 
  162.  1105   next ip
  163.  1110    RETURN ' ------------------------------------------
  164.  1115   '
  165.  1120   '
  166.  1125   '
  167.  1130   '
  168.  1135   '
  169.  25000    ' =================== PROCEDURE LOCATIONS ===========
  170.  25005    '  200 SET.SCREEN
  171.  25010    '  300 FILLER
  172.  25015    '  400 READ.LINE
  173.  25020    '  600 STORE.CELL
  174.  25025    '  800 PRINT.TABLE
  175.  25030    ' ================== PROGRAM ======================== 
  176.  25035    false = 0: true = not false 
  177.  25040   '
  178.  25045   cls: width "lpt1:",255
  179.  25050   screen 2                'use hi res graphics 200 x 640
  180.  25055   locate 2,1
  181.  25060   '
  182.  25065   print tab(5);"123-DOC: version 1.0"
  183.  25070   print tab(5);"A program to list a 123 documentation file as cells"
  184.  25075   '
  185.  25080   pset(1,1):draw "R500D30L500U30"
  186.  25085   pset(9,1):draw "R500D30L500U30"
  187.  25090   '
  188.  25095   locate 6,1
  189.  25100   print tab(5);"Cell width for print-out 5-100 (15)....";:input ncell.colw
  190.  25105   if ncell.colw=0 then ncell.colw=15
  191.  25110   if ncell.colw<5 then ncell.colw= 5
  192.  25115   if ncell.colw>100 then ncell.colw=100
  193.  25120   print tab(5);"Page width for print-out (132).........";:input max.chars
  194.  25125   if max.chars=0 then max.chars=132
  195.  25130   print tab(5);"Rows per page for printout (40)........";:input rp
  196.  25135   if rp=0 then rp=40
  197.  25140   '
  198.  25145   locate 20,1:files "b:*.prn"
  199.  25150   infile$=""
  200.  25155   while infile$=""
  201.  25160       locate 15,5
  202.  25165       input "Name of lotus file (b:........prn).....";infile$
  203.  25170   wend
  204.  25175   '
  205.  25180   if instr(infile$,":")=0 then infile$=left$("b:"+infile$,11)
  206.  25185   if instr(infile$,".")=0 then infile$=left$(infile$+".prn",14)
  207.  25190   '
  208.  25195   close
  209.  25200   open infile$ for input as #1
  210.  25205   lin=0: ipc=0: nr=0: nc=104: max.cols=0:ncell=0
  211.  25210   '
  212.  25215                       'load column tags
  213.  25220   GOSUB  300 ' FILLER
  214.  25225                       'set up the screen display
  215.  25230   GOSUB  200 ' SET.SCREEN
  216.  25235   '
  217.  25240   while not eof(1)
  218.  25245    GOSUB  400 ' READ.LINE
  219.  25250       status$=inkey$
  220.  25255       if status$=chr$(27) then end
  221.  25260                       'ic=0 implies blank line
  222.  25265   IF IC<>0 THEN GOSUB  600 ' STORE.CELL
  223.  25270                       'assume 50 lines/page+1
  224.  25275       IF NR=RP+1 OR NCELL>1000  THEN ELSE GO TO  25295
  225.  25280       GOSUB  800 ' PRINT.TABLE
  226.  25285       nr=0:ncell=0            'clear table
  227.  25290       GOSUB  200 ' SET.SCREEN
  228.  25295        ' IFEnd] 
  229.  25300   wend
  230.  25305       beep
  231.  25310       print"end of file found"
  232.  25315    GOSUB  800 ' PRINT.TABLE
  233.  25320   close
  234.  25325   '
  235.  25330   end
  236.     beep
  237.  25310       print"end of file found"
  238.  25315    GOSUB  800 ' PRINT.TABLE
  239.  25320   close
  240.  25325   '
  241.